home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / NIH Image 1.62b11 / Macros / Image Math < prev    next >
Encoding:
Text File  |  1996-02-08  |  3.1 KB  |  151 lines  |  [TEXT/Imag]
  1. procedure rmath(case:integer);
  2. var
  3.   pid:integer;
  4.   value:real;
  5. begin
  6.   pid:=PidNumber;
  7.   value:=GetNumber('Constant:', 10.0);
  8.   if case=1 then
  9.     ImageMath('copy', pid, pid, 1, value, pid)
  10.   else if case=2 then
  11.     ImageMath('copy real', pid, pid, 1, value, 'Real Result')
  12.   else  if case=3 then
  13.     ImageMath('copy', pid, pid, value, 0, pid)
  14.   else
  15.     ImageMath('copy real', pid, pid, value, 0, 'Real Result');
  16. end;
  17.  
  18. macro 'Add  Constant - 8-bit result…'; begin rmath(1); end;
  19. macro 'Add Constant - real result…'; begin rmath(2); end;
  20. macro 'Multiply by Constant - 8-bit result…'; begin rmath(3); end;
  21. macro 'Multiply by Constant - real result…'; begin rmath(4); end;
  22.  
  23. macro '(---'; begin end;
  24.  
  25. procedure StackMath(op: string);
  26. {Performs, slice by slice, the specied operation on two
  27. stacks and stores the result in the second stack.}
  28. var
  29.    i, d1, d2, d3, scale: integer;
  30.    offset, result: real;
  31. begin
  32.   if nPics<>2 then begin
  33.      PutMessage('This macro operates on exactly two stacks.');
  34.      exit;
  35.   end;
  36.   SelectPic(1);
  37.   KillRoi;
  38.   d1:=nSlices;
  39.   SelectPic(2);
  40.   KillRoi;
  41.   d2:=nSlices;
  42.   if d1<=d2
  43.      then d3:=d1
  44.      else d3:=d2;
  45.   if d3<2  then begin
  46.     PutMessage('This macro requires two stacks.');
  47.     exit;
  48.   end;
  49.   scale := 1.0;
  50.   offset := 0.0;
  51.   if op = 'add' then
  52.      scale := 0.5
  53.   else if op = 'subtract' then begin
  54.      scale := 0.5;
  55.      offset := 128;
  56.   end else if op = 'multiply' then
  57.       scale := 1
  58.   else if op = 'divide' then
  59.       scale := 255;
  60.   if (op = 'add') or (op = 'subtract') or (op = 'multiply') or (op = 'divide') then
  61.       scale := GetNumber('Scale factor:', scale);
  62.   if op = 'subtract'  then
  63.       offset := GetNumber('Offset:', offset);
  64.  SelectPic(2);
  65.   result := PidNumber;
  66.   for i:=1 to d3 do begin
  67.      SelectPic(1);
  68.      SelectSlice(i);
  69.      SelectPic(2);
  70.      SelectSlice(i);
  71.      ImageMath(op, 1, 2, scale, offset, result);
  72.   end;
  73. end;
  74.  
  75. Macro 'Add Two Stacks';
  76. begin
  77.   StackMath('Add');
  78. end;
  79.  
  80. Macro 'Subtract Two Stacks';
  81. begin
  82.   StackMath('Subtract');
  83. end;
  84.  
  85. Macro 'Multiply Two Stacks';
  86. begin
  87.   StackMath('Multiply');
  88. end;
  89.  
  90. Macro 'Divide Two Stacks';
  91. begin
  92.   StackMath('Divide');
  93. end;
  94.  
  95. Macro 'AND Two Stacks';
  96. begin
  97.   StackMath('AND');
  98. end;
  99.  
  100. Macro 'OR Two Stacks';
  101. begin
  102.   StackMath('OR');
  103. end;
  104.  
  105. Macro 'Max of Two Stacks';
  106. begin
  107.   StackMath('Max');
  108. end;
  109.  
  110. Macro 'Min of Two Stacks';
  111. begin
  112.   StackMath('Min');
  113. end;
  114.  
  115. macro '(---'; begin end;
  116.  
  117. macro 'Absolute Difference';
  118. begin
  119.   if nPics <> 2 then begin
  120.      beep;
  121.      PutMessage('Exactly two images required.');
  122.      exit;
  123.   end;
  124.   ImageMath('subtract', 1, 2, 1, 0, 'A-B');
  125.   ImageMath('subtract', 2, 1, 1, 0, 'B-A');
  126.   ImageMath('max', 3, 4, 1, 0, 'Absolute Difference');
  127.   SelectWindow('A-B');
  128.   Dispose;
  129.   SelectWindow('B-A');
  130.   Dispose;
  131. end;
  132.  
  133.  
  134. macro 'Real Processing Example';
  135. var
  136.   pid: integer;
  137. begin
  138.    SetNewSize(512,512);
  139.    MakeNewWindow('temp');
  140.    pid := PidNumber;
  141.    ImageMath('copy real', pid, pid, 1, 0, 'Real Image');
  142.    SelectPic(pid);
  143.    Dispose;
  144.    SelectWindow('Real Image');
  145.    {Process real image in user code routine}
  146.    pid := PidNumber;
  147.    ImageMath('copy real', pid, pid, 1, 0, pid); {do real to 8-bit scaling}
  148. end;
  149.  
  150.  
  151.